home *** CD-ROM | disk | FTP | other *** search
- program MyDemo;
- {
- purpose to demonstrate a typical Macintosh application
- }
-
- {$R-} { Turn off range checking }
- {$I-} { Turn off I/O error checking }
- {$B+} { Set bundle bit (for icon, etc.) }
- {$R MyDemo.Rsrc} { Identify resource file }
- {$T APPLDM01} { Set application ID }
- {$U-} { Turn off auto link to runtime units }
-
- uses PasInOut,Memtypes,QuickDraw,OSIntf,ToolIntf,PackIntf,MacPrint;
-
- const
- hiliteBit = 7; { flag bit in HiliteMode (lowMem flag) }
-
- MenuCnt = 5; { total # of menus }
- ApplMenu = 1000; { resource ID of Apple Menu }
- EditMenu = 1001; { resource ID of Edit Menu }
- InfoMenu = 1002; { resource ID of Info Menu }
- GrafMenu = 1003; { resource ID of Grafics Menu }
- DiskMenu = 1004; { resource ID of Disk Menu }
-
- AM = 1; { index into MenuList for Apple Menu }
- EM = 2; { ditto for Edit Menu }
- IM = 3; { ditto for Information Menu }
- GM = 4; { ditto for Grafics Menu }
- DM = 5; { ditto for Disk Menu }
-
- MainID = 1000; { resource ID for MainWindow }
- AboutID = 1000; { resource ID for dialog box }
- Text1ID = 1000; { resource IDs for 'About...' text }
- Text2ID = 1001;
- Text3ID = 1002;
-
- myCursID = 1000; { resource ID for myCursor }
- myCursor = 5; { array index for myCursor }
-
- BSize = 512; { buffer size for DiskI/O }
- BCount = 256; { buffer count for Disk I/O }
-
- type
- Buffer = packed array[1..BSize] of Char; { used for DiskI/O }
- BufFile = file of Buffer; { ditto }
- CursorList = array[iBeamCursor..myCursor] of CursHandle;
- PtrInteger = ^integer;
- PtrString = ^str255;
-
- var
- HiliteMode : Ptr;
-
- F : file of Buffer; { used in I/O routines }
- Finished : Boolean; { used to terminate the program }
- Ticks : Longint; { keeps track of time }
- TV,TH : Integer; { location of text }
- theEvent : EventRecord; { event passed from operating system }
-
-
- { Screen stuff}
- DragArea : Rect; { defines area where window can be dragged in }
- GrowArea : Rect; { defines area to which a window's size can change }
- ScreenArea : Rect; { defines screen dimensions }
- CursList : CursorList; { used to hold cursor handles }
-
- { Menu stuff}
- MenuList : array[1..MenuCnt] of MenuHandle; { holds menu info }
-
- { Window stuff }
- MainPtr : WindowPtr; { pointer to main window }
- MainRec : WindowRecord; { holds data for main window }
- MainPeek : WindowPeek; { pointer to MainRec }
- ScreenPort : GrafPtr; { pointer to entire screen }
- FrontWindow : WindowPtr; { pointer to active window }
-
- { program specific stuff}
- VFlag : boolean;
- FileSelected : Boolean; { if true, file is selected }
- VolParmBlock : ParmBlkPtr;
- FileParmBlock : ParmBlkPtr;
- Reply : SFReply;
- SPtr : StringPtr;
-
-
- procedure ClearWindow(WPtr : WindowPtr);
- {
- purpose clears window, draws grow stuff, sets location
- }
- var
- TRect : Rect;
- begin
- if (WPtr = MainPtr) and (Wptr = FrontWindow ) then begin
- EraseRect(WPtr^.portRect); { clear rect area of window }
- DrawGrowIcon(WPtr); { draw grow icon }
- TH := 5; TV := 12 { set text loc to upper left }
- end
- end; { of proc ClearWindow }
-
- procedure DrawStart(Str : String);
- {
- purpose moves to text location and writes out Str
- }
- begin
- MoveTo(TH,TV); { move to current text location }
- DrawString(Str); { write on screen }
- TH := TH + StringWidth(Str) { advance location to end of str}
- end; { of proc DrawStart }
-
- procedure RealToStr(Val : Real; var Str : String);
- {
- purpose does conversion from real number to string
- can be replaced with RealToString(Val,Digits,Style)
- }
- var
- Int,Frac : LongInt;
- TStr : String;
- begin
- Str := ''; { set string to null }
- Int := Trunc(Val); { get integer portion of val}
- Frac := Round(10.0*(Val-Int)); { get fractional part of val}
- NumToString(Int,Str); { convert int to string }
- NumToString(Frac,TStr); { convert fract to string }
- Str := Str+'.'+TStr { put decimal point between }
- end; { of proc RealToStr }
-
- procedure DrawEnd(Ticks : Longint);
- {
- purpose finish message with time in seconds
- }
- var
- Str : String;
- begin
- MoveTo(TH,TV); { move to our text location }
- DrawString(' in '); { write out string }
- RealToStr(Ticks/60.0,Str); { convert ticks to second }
- Str := Str+' seconds'; { concat with string }
- DrawString(Str); { and write that out }
- TV := TV + 12; TH := 5 { set to start of next line }
- end; { of proc DrawEnd }
-
-
-
- { ********* items in Info Menu *********** }
- PROCEDURE DrawStuff;
- VAR
- theString : Str255;
- theRect : Rect;
-
- BEGIN
- theString := 'This should be white-on-black.';
- SetRect(theRect, 128, 195, 384, 257);
- FillRect(theRect, black);
- TextFace([outline]);
- PenMode(srcBic);
- MoveTo(theRect.left + 10, theRect.top + 20);
- DrawString(theString);
- MoveTo(theRect.left + 10, theRect.top + 40);
- DrawString(theString);
- END;
-
- PROCEDURE InvertText;
- {
- Example of printing inverted text on the LaserWriter.
- 6/25/87 ...ZZ
- }
- VAR
- thePrRec : THPrint;
- thePrPort : TPPrPort;
- theStatus : TPrStatus;
- oldPort : GrafPtr;
-
- BEGIN
- GetPort(oldPort);
- thePrRec := THPrint(NewHandle(SIZEOF(TPrint)));
-
- DrawStuff;
-
- PrOpen;
- PrintDefault(thePrRec);
- IF PrStlDialog(thePrRec) THEN BEGIN
- IF PrJobDialog(thePrRec) THEN BEGIN
- thePrPort := PrOpenDoc(thePrRec, NIL, NIL);
- IF PrError = noErr THEN BEGIN
- PrOpenPage(thePrPort, NIL);
- IF PrError = noErr THEN BEGIN
- SetPort(@thePrPort^.gPort);
- { Draw things to be printed here. }
- DrawStuff;
- END;
- PrClosePage(thePrPort)
- END;
- END;
- END;
- PrCloseDoc(thePrPort);
- IF (thePrRec^^.prJob.bJDocLoop = bSpoolLoop) and (PrError = noErr) THEN
- PrPicFile(thePrRec, NIL, NIL, NIL, theStatus);
- PrClose;
-
- SetPort(oldPort);
- END;
-
-
- procedure DoSort;
- {
- purpose does selection sort on list of <Count> strings
- }
- const
- Count = 500;
- type
- NumStr = string[7];
- var
- List : array[1..Count] of NumStr;
- S : NumStr;
- T : String;
- L : Longint;
- I,J,Min : Integer;
- begin
- L := 1000000 + Count; { set up list in reverse order }
- for I := 1 to Count do begin { for each slot in array do }
- NumToString(L,T); { convert value to string }
- List[I] := T; { store in array }
- L := L - 1 { decrease value by one }
- end;
- NumToString(Ord4(Count),T); { convert Count to string }
- DrawStart('Sorts '+T+' strings'); { write starting message }
- Ticks := Tickcount; { *** start timing *** }
- for I := 1 to Count-1 do begin { I = current top of list }
- Min := I; { assume List[I] = lowest val }
- for J := I+1 to Count do { look in rest of list }
- if List[J] < List[Min] { if a lower value is found }
- then Min := J; { then remember where it is }
- S := List[I]; { swap lowest value with top }
- List[I] := List[Min];
- List[Min] := S
- end;
- DrawEnd(Tickcount-Ticks) { *** stop timing *** }
- end; { of proc DoSort }
-
- procedure DoMacInfo;
- { purpose display some information about the macintosh }
- var
- CPUFlag : ptr;
- HWCFgFlags : ptr;
- RomVersion : PtrInteger;
- AString : str255;
- Version : StringPtr;
- HFSFlag : PtrInteger;
- RomVersionByte : ptr;
- begin
-
- CPUFlag := Ptr($12F); { CPU flag global }
- MoveTo(50,100); DrawString('MicroProcessor: ');
- case CPUFlag^ of
- 0 : DrawString('68000');
- 1 : DrawString('68010');
- 2 : DrawString('68020');
- end;
-
- HWCFgFlags := Ptr($B22); { Hardware Equipment Flag }
- MoveTo(50,125);
- if (HWCFgFLags^ and $80) = $80 then
- DrawString('MacPlus')
- else
- DrawString('Mac');
-
- RomVersion := PtrInteger($400008); { Mac ROM version flag }
- MoveTo(50,150); DrawString('ROM Version Number: ');
- if RomVersion^ = $0069 then
- DrawString('Old 64K')
- else
- if RomVersion^ = $70FF then
- DrawString('New XL')
- else
- if RomVersion^ = $0075 Then
- begin
- DrawString('128K ');
- RomVersionByte := Ptr($400002); { It's the New Roms }
- case RomVersionByte^ of { test for which version # }
- $EE : DrawString('V1');
- $F4 : DrawString('V2');
- $EA : DrawString('V3');
- end;
- end;
-
- HFSFlag := PtrInteger($3F6); { HFS file system global }
- MoveTo(50,175); DrawString('File System: ');
- if HFSFlag^ > 0 then
- DrawString('HFS')
- else
- DrawString('MFS');
- end;
-
-
- { ********* items in Graphics Menu *********** }
-
- procedure DoRectangle;
- {
- purpose draws a lot of rectangles
- }
- const
- Count = 100;
- var
- R : Rect;
- I,RX1,RX2,RY1,RY2 : Integer;
- WindowPort : GrafPtr;
- AString : str255;
- begin
- for I := 1 to Count do { for Count times do... }
- begin
- { set bounds of rectangle }
- GetPort(WindowPort);
-
- RX1 := abs(Random) mod (WindowPort^.portRect.right-15);
- RY1 := abs(Random) mod (WindowPort^.portRect.bottom-15);
- RX2 := abs(Random) mod (WindowPort^.portRect.right-15);
- RY2 := abs(Random) mod (WindowPort^.portRect.bottom-15);
-
- SetRect(R,RX1,RY1,RX2,RY2);
- FrameRect(R); { draw rectangle }
- end;
- end; { of proc DoRectangle }
-
- procedure DoCircle;
- {
- purpose draws and then paints over a lot of circles
- }
- const
- Count = 100;
- var
- R : Rect;
- I : Integer;
- WindowPort : grafPtr;
- RX1,RX2,RY1,RY2 : Integer;
- begin
- for I := 1 to Count do { for Count times do... }
- begin
- { set bounds of rectangle }
- GetPort(WindowPort);
-
- RX1 := abs(Random) mod (WindowPort^.portRect.right-15);
- RY1 := abs(Random) mod (WindowPort^.portRect.bottom-15);
- RX2 := abs(Random) mod (WindowPort^.portRect.right-15);
- RY2 := abs(Random) mod (WindowPort^.portRect.bottom-15);
-
- SetRect(R,RX1,RY1,RX2,RY2);
- FrameOval(R); { draw a black circle }
- end;
- end; { of proc DoCircle }
-
-
- { ********* items in Disk I/O Menu *********** }
-
-
- procedure DoGetVolInfo;
- { Displays Information about the Default Volume }
- var
- theErr : OSErr;
- AString : str255;
- Secs : LongInt;
- DateVar,TimeVar : str255;
-
- begin
-
- SPtr^ := '';
- VolParmBlock^.ioNamePtr := SPtr; { set volume name to default vol }
- VolParmBlock^.ioCompletion := nil;
- VolParmBlock^.ioVolIndex := 0;
- theErr := PBGetVInfo(VolParmBlock,false);
-
- { display volume name }
- MoveTo(50,75);
- DrawString('Volume Name:');
- MoveTo(200,75);
- DrawString(VolParmBlock^.ioNamePtr^);
-
- { display date and time of volume creation }
- Secs := VolParmBlock^.ioVCrDate;
- IUDateString(Secs,abbrevDate,DateVar);
- IUTimeString(Secs,true,TimeVar);
- MoveTo(50,100);
- DrawString('Volume Created:');
- AString := DateVar+' '+TimeVar;
- MoveTo(200,100);
- DrawString(AString);
-
- { display date and time of last volume backup }
- Secs := VolParmBlock^.ioVLsBkUp;
- IUDateString(Secs,abbrevDate,DateVar);
- IUTimeString(Secs,true,TimeVar);
- MoveTo(50,125);
- DrawString('Last Backup:');
- AString := DateVar+' '+TimeVar;
- MoveTo(200,125);
- DrawString(AString);
-
- { display number of files in the current volume }
- { note: for HFS volumes this is the number of }
- { files in the current folder }
- NumToString(VolParmBlock^.ioVNmFls,AString);
- MoveTo(50,150);
- DrawString('Number of Files:');
- MoveTo(200,150);
- DrawString(AString);
-
- end;
-
-
- procedure DoOpenFile;
- { Brings up Dialog Box and Opens a File }
- var
- topLeft : Point;
- FileFilter : SFTypeList;
- theErr : OSErr;
- AString : str255;
- begin
-
- topLeft.h := 90; { top left horiz point for Get File dialog }
- topLeft.v := 80; { top left vert " " " " " }
- FileFilter[0] := 'TEXT'; { file filter for text files }
-
- SFGetFile(topLeft,'',nil,-1,FileFilter,nil,Reply);
- if Reply.Good then
- begin
- FileSelected := true;
- FileParmBlock^.ioCompletion := nil;
- FileParmBlock^.ioVRefNum := Reply.vRefNum;
- FileParmBlock^.ioNamePtr := @Reply.fName;
- FileParmBlock^.ioVersNum := 0;
- FileParmBlock^.ioPermssn := 0;
- FileParmBlock^.ioMisc := nil;
-
- theErr := PBOpen(FileParmBlock,false);
- VolParmBlock^.ioVRefNum := FileParmBlock^.ioVRefNum;
- VolParmBlock^.ioCompletion := nil;
- SPtr^ := '';
- VolParmBlock^.ioNamePtr := SPtr; { set volume name to default vol }
- theErr := PBSetVol(VolParmBlock,false); { update vol ref # }
- end;
- end;
-
-
- procedure DoGetFileInfo;
- { Displays Information about the Current File }
- var
- theErr : OSErr;
- DateVar,TimeVar : str255;
- AString : str255;
- Secs : LongInt;
-
- begin
-
- theErr := PBGetFInfo(FileParmBlock, false); { Get File Information }
-
- { display file name }
- MoveTo(50,75);
- DrawString('File Name:');
- MoveTo(200,75);
- DrawString(FileParmBlock^.ioNamePtr^);
-
- { display date file was created }
- Secs := FileParmBlock^.ioFlCrDat;
- IUDateString(Secs,abbrevDate,DateVar);
- IUTimeString(Secs,true,TimeVar);
- MoveTo(50,100);
- DrawString('File Created:');
- AString := DateVar+' '+TimeVar;
- MoveTo(200,100);
- DrawString(AString);
-
- { display date file was last modified }
- Secs := FileParmBlock^.ioFlMDDat;
- IUDateString(Secs,abbrevDate,DateVar);
- IUTimeString(Secs,true,TimeVar);
- MoveTo(50,125);
- DrawString('Last Modified:');
- AString := DateVar+' '+TimeVar;
- MoveTo(200,125);
- DrawString(AString);
-
- { display length of data fork }
- MoveTo(50,150);
- DrawString('Size of Data Fork:');
- NumToString(FileParmBlock^.ioFlLgLen,AString);
- MoveTo(200,150);
- DrawString(AString);
-
- { display length of resource fork }
- MoveTo(50,175);
- DrawString('Size of Resource Fork:');
- NumToString(FileParmBlock^.ioFlRLgLen,AString);
- MoveTo(200,175);
- DrawString(AString);
- end;
-
- procedure DoCloseFile;
- { Closes the current File }
- var
- theErr : OSErr;
- begin
- theErr := PBClose(FileParmBlock,false);
- FileSelected := false;
- end;
-
-
-
- { ********* items in Apple Menu *********** }
-
- procedure DoAbout;
- {
- purpose bring up 'About...' box using a dialog box
- }
- var
- theItem : Integer;
- AboutPtr : DialogPtr;
- S1,S2,S3 : StringHandle;
- begin
- SetCursor(CursList[myCursor]^^); { set to my cursor }
- ShowCursor; { and turn it back on }
- S1 := GetString(Text1ID); { get text from resource file }
- S2 := GetString(Text2ID);
- S3 := GetString(Text3ID);
- ParamText(S1^^,S2^^,S3^^,''); { and set up as parameter text }
- AboutPtr := getNewDialog(AboutID,NIL,Pointer(-1)); { get dialog box}
- ModalDialog(NIL,theItem); { put dialog box up; get result }
- DisposDialog(AboutPtr); { get rid of dialog box }
- SetCursor(Arrow)
- end; { of proc DoAbout }
-
- procedure DoDeskAcc(Item : Integer);
- {
- purpose start up desk accessory from Apple menu
- }
- var
- SavePort : GrafPtr;
- RefNum : Integer;
- DName : String;
- begin
- GetPort(SavePort); { save port before starting it }
- GetItem(MenuList[AM],Item,DName); { get name of desk accessory }
- refNum := OpenDeskAcc(DName); { and start that sucker up! }
- SetPort(SavePort); { restore grafport and continue }
- end; { of proc DoDeskAcc }
-
- { ********* event handling routines *********** }
-
- procedure ToggleFlag(var Flag : Boolean; Mndx,Indx : Integer);
- {
- purpose checks or de-checks item Indx in menu Mndx
- last update 20 Aug 86
- }
- var
- Ch : Char;
- begin
- Flag := not Flag; { toggle flag (for you) }
- if Flag { if flag is True... }
- then Ch := Chr(CheckMark) { then check item in menu }
- else Ch := Chr(NoMark); { else clear any checkmark }
- SetItemMark(MenuList[Mndx],Indx,Ch) { put char by item in menu }
- end; { of proc ToggleFlag }
-
- procedure SetItemState(Mndx,Indx : Integer; Flag : Boolean);
- {
- purpose if true, enables item Indx of menu Mndx; else disables
- last update 22 Aug 86
- }
- begin
- if Flag
- then EnableItem (MenuList[Mndx],Indx)
- else DisableItem(MenuList[Mndx],Indx)
- end; { of proc SetItemState }
-
- procedure UpdateMenu;
- {
- purpose enable or disable items in I/O menu as needed
- }
- begin
- SetItemState(DM,3,FileSelected); { update file Info }
- SetItemState(DM,4,FileSelected); { ditto }
- end; { of proc UpdateMenu }
-
- procedure HandleMenu(MenuInfo : LongInt);
- {
- purpose decode MenuInfo and carry out command
- }
- var
- Menu : Integer; { menu number that was selected }
- Item : Integer; { item in menu that was selected }
- B : Boolean; { dummy flag for SystemEdit call }
- begin
- if MenuInfo <> 0 then begin
- ClearWindow(MainPtr); { we're clearing the window }
- PenNormal; { set the pen back to normal }
- Menu := HiWord(MenuInfo); { find which menu the command is in }
- Item := LoWord(MenuInfo); { get the command number }
- case Menu of { and carry it out }
- ApplMenu : if Item = 1
- then DoAbout { bring up "About..." window}
- else DoDeskAcc(Item); { start desk accessory }
- EditMenu : case Item of
- 1,3..6 : if not SystemEdit(Item-1) { pass to desk acc }
- then { do nothing };
- 8 : Finished := True; { Quit command }
- end;
- InfoMenu : case Item of { Information Menu }
- 1 : InvertText;
- 2 : DoSort;
- 3 : DoMacInfo;
- end;
-
- GrafMenu : case Item of { Graphics menu }
- 1 : DoCircle;
- 2 : DoRectangle;
- end;
-
- DiskMenu : case Item of { Disk I/O menu }
- 1 : DoGetVolInfo;
- 2 : DoOpenFile;
- 3 : DoGetFileInfo;
- 4 : DoCloseFile;
- 6 : ToggleFlag(VFlag,DM,Item); { toggle check mark }
- end
- end;{case of Menu}
- HiliteMenu(0); { reset menu bar }
- if Menu = DiskMenu
- then UpdateMenu; { make any changes needed }
- end
- end; {of proc HandleMenu}
-
- procedure HandleClick(WPtr : WindowPtr; MLoc : Point);
- {
- purpose handle mouse click within window
- }
- begin
- if WPtr = MainPtr { if this is our window... }
- then if WPtr <> FrontWindow { and it's not in front... }
- then SelectWindow(WPtr) { ...then make it active }
- end; { of proc HandleClick }
-
- procedure HandleGoAway(WPtr : WindowPtr; MLoc : Point);
- {
- purpose handle mouse click in go-away box
- }
- var
- WPeek : WindowPeek; { for looking at windows }
- begin
- if WPtr = FrontWindow then begin { if it's the active window }
- WPeek := WindowPeek(WPtr); { peek at the window }
- if TrackGoAway(WPtr,MLoc) then begin { and the box is clicked }
- if WPeek^.WindowKind = userKind { if it's our window }
- then Finished := True { then time to stop }
- else CloseDeskAcc(WPeek^.WindowKind){ else close DeskAcc }
- end
- end
- else SelectWindow(WPtr) { else make it active }
- end; { of proc HandleGoAway }
-
- procedure HandleGrow(WPtr : WindowPtr; MLoc : Point);
- {
- purpose handle mouse click in grow box
- }
- type
- GrowRec =
- record
- case Integer of
- 0 : (Result : LongInt);
- 1 : (Height,Width : Integer)
- end;
- var
- GrowInfo : GrowRec;
- begin
- if WPtr = MainPtr then with GrowInfo do begin { if it's our window }
- Result := GrowWindow(WPtr,MLoc,GrowArea); { get amt of growth }
- SizeWindow(WPtr,Width,Height,True); { resize window }
- InvalRect(WPtr^.portRect) { set up for update }
- end
- end; { of proc HandleGrow }
-
- procedure DoMouseDown(theEvent:EventRecord);
- {
- purpose identify where mouse was clicked and handle it
- }
- var
- Location : Integer;
- theWindow : WindowPtr;
- MLoc : Point;
- WLoc : Integer;
- begin
- MLoc := theEvent.Where; { get mouse position }
- WLoc := FindWindow(MLoc,theWindow); { get window, loc in window }
- case WLoc of { handle window locations }
- InMenuBar : HandleMenu(MenuSelect(MLoc)); { in the menu }
- InContent : HandleClick(theWindow,MLoc); { inside the window }
- InGoAway : HandleGoAway(theWindow,MLoc); { in the go away box}
- InGrow : HandleGrow(theWindow,MLoc); { in the grow box }
- InDrag : DragWindow(theWindow,MLoc,DragArea); { in the drag bar}
- InSysWindow : SystemClick(theEvent,theWindow) { in a DA window }
- end
- end; { of proc DoMouseDown }
-
- procedure DoKeypress(theEvent : EventRecord);
- {
- purpose handles keypress (keyDown, autoKey) event
- }
- var
- KeyCh : Char;
- begin
- if (theEvent.modifiers and cmdKey) <> 0 then begin { menu key command }
- KeyCh := Chr(theEvent.Message and charCodeMask); { decode character }
- HandleMenu(MenuKey(KeyCh)) { get menu and item}
- end
- else SysBeep(1) { do *something* }
- end; { of proc DoKeypress }
-
- procedure DoUpdate(theEvent : EventRecord);
- {
- purpose handles window update event
- }
- var
- SavePort,theWindow : WindowPtr;
- begin
- theWindow := WindowPtr(theEvent.Message); { find which window }
- if theWindow = MainPtr then begin { only update ours }
- SetCursor(CursList[watchCursor]^^); { set cursor to watch }
- GetPort(SavePort); { save current grafport }
- SetPort(theWindow); { set as current port }
- BeginUpdate(theWindow); { signal start of update}
-
- { and here's the update stuff! }
- ClearWindow(theWindow); { do update stuff }
- { now, back to our program...}
-
- EndUpdate(theWindow); { signal end of update }
- SetPort(SavePort); { restore grafport }
- SetCursor(Arrow) { restore cursor }
- end
- end; { of proc DoUpdate }
-
- procedure DoActivate(theEvent : EventRecord);
- {
- purpose handles window activation event
- }
- var
- I : Integer;
- AFlag : Boolean;
- theWindow : WindowPtr;
- begin
- with theEvent do begin
- theWindow := WindowPtr(Message); { get the window }
- AFlag := Odd(Modifiers); { get activate/deactive }
- if AFlag then begin { if it's activated... }
- SetPort(theWindow); { make it the port }
- FrontWindow := theWindow; { know it's in front }
- DrawGrowIcon(theWindow); { set size box }
- end
- else begin
- SetPort(ScreenPort); { else reassign port }
- if theWindow = FrontWindow { if it's in front }
- then FrontWindow := NIL { ...then forget that }
- end;
- if theWindow = MainPtr then begin { if it's our window }
- SetItemState(EM,1,not AFlag); { update edit cmds }
- for I := 3 to 6 do
- SetItemState(EM,I,not AFlag);
- SetItemState(EM,8,AFlag); { update Quit command }
- for I := IM to DM do { update other menus }
- SetItemState(I,0,AFlag);
- DrawMenuBar { update menu bar }
- end
- end
- end; { of proc DoActivate }
-
- procedure Initialize;
- {
- purpose initialize everything for the program
- }
- var
- Indx : Integer;
- Result : Real;
- begin
- { initialize all the different managers }
- InitGraf(@thePort); { create a grafport for the screen }
- InitFonts; { start up the font manager }
- InitWindows; { start up the window manager }
- InitMenus; { start up the menu manager }
- TEInit; { start up the text manager for DAs }
- InitDialogs(NIL); { start up the dialog manager }
- FlushEvents(everyEvent,0); { clear events from previous state }
-
- { get four standard system cursors, plus one custom one }
- for Indx := iBeamCursor to watchCursor do begin
- CursList[Indx]:=GetCursor(Indx); { read in from system resource }
- HLock(Handle(CursList[Indx])) { lock the handle down }
- end;
- CursList[myCursor] := GetCursor(MyCursID); { get cursor from resources}
- HLock(Handle(CursList[myCursor])); { and lock it down }
- SetCursor(CursList[watchCursor]^^);{ bring up watch cursor }
-
- { set up menus }
- MenuList[AM] := GetMenu(ApplMenu);{ read menus in from resource fork }
- MenuList[EM] := GetMenu(EditMenu);
- MenuList[IM] := GetMenu(InfoMenu);
- MenuList[GM] := GetMenu(GrafMenu);
- MenuList[DM] := GetMenu(DiskMenu);
- AddResMenu(MenuList[AM],'DRVR'); { pull in all desk accessories }
- for Indx := 1 to MenuCnt do { place menus in menu bar }
- InsertMenu(MenuList[Indx],0);
- DrawMenuBar; { draw updated menu bar to screen }
-
- { set up window stuff }
- GetWMgrPort(ScreenPort); { get grafport for all windows }
- SetPort(ScreenPort); { and keep hand just in case }
- MainPtr := GetNewWindow(MainID,@MainRec,Pointer(-1)); { get window }
- SetPort(MainPtr); { set window to current graf port }
- SelectWindow(MainPtr); { and make window active }
- FrontWindow := MainPtr; { remember that it's in front }
- DrawGrowIcon(MainPtr); { draw the grow box in the corner }
- MainPeek := WindowPeek(MainPtr); { get pointer to window record }
- MainPeek^.windowKind := UserKind; { set window type = user kind (ID=8)}
- ScreenArea := screenBits.Bounds; { get size of screen (don't assume) }
- with ScreenArea do begin
- SetRect(DragArea,5,38,Right-5,Bottom-10); { set drag region }
- SetRect(GrowArea,50,20,Right-5,Bottom-10) { set grow region }
- end;
-
- { program-specific initialization }
- VFlag := False;
- FileSelected := False; { set file opened false }
- New(SPtr);
- New(VolParmBlock);
- New(FileParmBLock);
- VolParmBlock^.ioVRefNum := 0;
-
- UpdateMenu; { update menu as needed }
- Finished := False { set program terminator to false }
- end; { of proc Initialize }
-
- procedure CleanUp;
- {
- purpose to do whatever's needed before returning to Finder
- }
- begin
- DisposeWindow(MainPtr) { get rid of the main window }
- end; { of proc CleanUp }
-
- procedure CursorAdjust;
- {
- purpose change cursors depending upon location
- }
- var
- MousePt : Point;
- begin
- if MainPtr = FrontWindow then with MainPeek^ do begin
- GetMouse(MousePt); { find where mouse is }
- if PtInRect(MousePt,port.portRect) then { if over window then }
- if Button { if button down... }
- then SetCursor(CursList[plusCursor]^^) { then make a plus }
- else SetCursor(CursList[crossCursor]^^){ else make a cross }
- else SetCursor(Arrow) { else make an arrow }
- end
- end; { of proc CursorAdjust }
-
- procedure HandleEvent(theEvent : EventRecord);
- {
- purpose decodes event and handles it
- }
- begin
- case theEvent.What of
- mouseDown : DoMouseDown(theEvent); { mouse button pushed }
- keyDown : DoKeyPress(theEvent); { key pressed down }
- autoKey : DoKeyPress(theEvent); { key held down }
- updateEvt : DoUpdate(theEvent); { window need updating }
- activateEvt : DoActivate(theEvent) { window made act/inact }
- end
- end; { of proc HandleEvent }
-
- begin { main body of program MyDemo }
- Initialize; { set everything up }
- repeat { keep doing the following }
- SystemTask; { update desk accessories }
- CursorAdjust; { update which cursor }
- if GetNextEvent(everyEvent,theEvent) { if there's an event... }
- then HandleEvent(theEvent) { ...then handle it }
- until Finished; { until user is done }
- Cleanup { clean everything up }
- end. { of program MyDemo }
-